DEFINT a-z
SCREEN 1,640,400,3,2
WINDOW 2,"KEYBIRD (keyboard enhancer)",(0,8)-(631,186),16,1
PALETTE 0,0.06,0.73,0.33         'green       (background)
PALETTE 1,  1,  1,  1         'white       (foreground)
PALETTE 2,0.5,0.5,  0.5         'light grey
PALETTE 3,  0.78,  0,  0         'red  (=chosen)
PALETTE 4,  0,  0,0.73         'blue (=not chosen)
PALETTE 5, 1,  0.64,  0.64       'light red
PALETTE 6,  0,  0,  0         'black
PALETTE 7,0.46,  0.8,1         'light blue (menu text)
REM   GOTO skipabove
MENU 1,0,1,"Keybird Projects "
MENU 2,0,1,""
MENU 3,0,1,""
MENU 4,0,1,""
skipabove:
black =     6   
red =       3
BLUE =      4
lightred =  5
lightblue = 7
lightgrey = 2
green     = 0
white     = 1
back      = lightblue
cdt       = 28     'countdown 28 seconds
textkey   = 127    'included here because printt needs it
true = (1=1)
false = (1=0)
DIM SHARED clr(136),ulx(136),uly(136),lrx(136),lry(136)
DIM SHARED nxt(136)
textx=20:texty=8:CALL printt("Thanks for your patience...",1)
COLOR 1,0
ON TIMER(1) GOSUB timeslice
TIMER ON
ulx(0)=-2:uly(0)=-2  'fake out getkeycode
CALL getkeycode(k,-1,-1)  'an early call to every subroutine helps amigabasic seem to run faster 
GOSUB arrayallocation
GOSUB constantdefinitions
GOSUB statevariables
GOTO  mainloop
REM ********************************************************
arrayallocation:
REM ********************************************************
DIM SHARED C$(136),c2$(119),texx(136),texy(136),reverse(7),otherchoice(7)
DIM SHARED exp2(3),ml$(16)
DIM SHARED keys(3,119,15),a$(119,15)
DIM SHARED d(32),typ(119),num(15),use(16,15)
DIM SHARED buff(2000),modi$(201),actionmsg$(12)
REM 201 is 1 more than the maximum number of modifiable keys allowed
DIM SHARED buffreloc$(200),clrextract(5,6)
DIM SHARED deadcount(41),deadcode(41)
REM 41 is 1 more than the maximum number of deadkeys allowed
REM keys(1,k,0) is red or blue depending if k is capsable or not
REM keys(2,k,0) is red or blue depending if k is repeatable or not
REM keys(3,k,j) is a code combining info about deadkeys, modifiable, and
RETURN
REM *****************************************
constantdefinitions:
REM *****************************************  
maxmod    = 201
topdead   =  41
active    = 1
inactive  = 0
dedkey=125
modkey=126
textkey=127
actionkey=128
modi$(0)  = "dummy"    'must have non-zero length
reverse(black)     = lightgrey
reverse(red)       = lightred
reverse(BLUE)      = lightblue
reverse(lightred)  = red
reverse(lightblue) = BLUE
reverse(lightgrey) = black
otherchoice(red)   = BLUE
otherchoice(lightred) = lightblue
otherchoice(BLUE)  = red
otherchoice(lightblue) = lightred
exp2(0)=1
exp2(1)=2
exp2(2)=4
exp2(3)=8
wid =  15
hei =  20
keymap = 5
modifiable = 4
deadkeys = 3
repeatable = 2
capsable = 1
mustextract = 3
black.black.black  = 1
red.blue.hardblue  = 2
blue.red.hardblue  = 3
blue.blue.hardblue = 4
blue.blue.softblue = 5
blue.blue.red      =6
RESTORE extractdata
FOR i=1 TO 6
 FOR j=capsable TO keymap
   READ clrextract(j,i)
 NEXT j
 READ comment$
NEXT i
extractdata:
REM   capsable,repeatable,deadkeys,modifiable,keymap
DATA  6,        6,        6,       6,         6,   i=1
DATA  6,        6,        3,       4,         4,   i=2 (hardblue)
DATA  3,        3,        4,       3,         4,   i=3 (hardblue)
DATA  4,        4,        4,       4,         4,   i=4 (hardblue)
DATA  6,        6,        4,       4,         4,   i=5 (softblue)
DATA  6,        6,        4,       4,         3,   i=6   
buffreserved = 2000
  ml$(16)= "                  "
  ml$(15)= "Dnup-Shft-Alt-Ctrl"
  ml$(14)= "Downup-Alt-Ctrl   "
  ml$(13)= "Downup-Shift-Ctrl "
  ml$(12)= "Downup-Ctrl       "
  ml$(11)= "Downup-Shift-Alt  "
  ml$(10)= "Downup-Alt        "
  ml$(9) = "Downup-Shift      "
  ml$(8) = "Downup            "
  ml$(7) = "Shift-Alt-Ctrl    "
  ml$(6) = "Alt-Ctrl          "   
  ml$(5) = "Shift-Ctrl        "
  ml$(4) = "Ctrl              "
  ml$(3) = "Shift-Alt         "
  ml$(2) = "Alt               "
  ml$(1) = "Shift             "
  ml$(0) = "alone             "
  actionmsg$(1) ="Make      Capsable  "
  actionmsg$(2) ="Make NOT  Capsable  "
  actionmsg$(3) ="Make      Repeatable"
  actionmsg$(4) ="Make NOT  Repeatable"
  actionmsg$(5) ="Make      DeadKey   "
  actionmsg$(6) ="Make NOT  DeadKey   "
  actionmsg$(7) ="Make      Modifiable"
  actionmsg$(8) ="Make NOT  Modifiable"
  actionmsg$(9) ="Make      Active    "
  actionmsg$(10)="Make NOT  Active    "
  actionmsg$(11)="No Action           "  
  actionmsg$(12)="Make CLONEof Deadkey"
FOR i=0 TO 136:nxt(i)=i+1:NEXT i
nxt(0)=124              'for quick handling of commands
nxt(124)=120            'keymap box overlaps 4 others, so
nxt(123)=125            ' we must test it first
nxt(135)=1              'now go back and pick up keyboard
nxt(103)=136            'skip 104-119
GOSUB setupnum
  RESTORE keydata
  READ a,b,C,d,e,comment$ 
  WHILE a >= 0
    ulx(a)=b
    uly(a)=C
    lrx(a)=d
    lry(a)=e
    C$(a) = comment$
    IF a=136 THEN GOTO readnext
    IF (a=71) OR (a=68) THEN
       'do not plot a box
    ELSE
       LINE(ulx(a),uly(a))-(lrx(a),lry(a)),,b
    END IF
readnext:
    READ a,b,C,d,e,comment$
  WEND
FOR i=0 TO 103
    c2$(i) = MID$(C$(i),1,2)
    texx(i) = (ulx(i)/8)+2
    texy(i) = (uly(i)/8)+2
NEXT i
FOR i=120 TO 135
    texx(i) = (ulx(i)/8)+2
    texy(i) = (uly(i)/8)+2
NEXT i
    textx=texx(textkey):texty=texy(textkey)
COLOR black,green  
LOCATE 21,27:PRINT "Old:";
LOCATE 22,27:PRINT "New:";
MENU 1,0,1,"Keybird Project "
MENU 1,1,1,"New  keymap     "
MENU 1,2,1,"Load keymap     "
MENU 1,3,1,"Save keymap     "
MENU 1,4,1,"About           "
MENU 1,5,1,"Quit            "
MENU 1,0,0
ON MENU GOSUB menuh
ON MOUSE GOSUB leftmouse
ON BREAK GOSUB breakh
BREAK ON
COLOR white,green:LOCATE 1,1:PRINT "End initialize"
RETURN
REM ********************************************************
statevariables:
REM ********************************************************
f$="usa2"
state = 1        'start in Capsable state
q     = 0        'no qualifiers
undefined = 999
errno = 0
action = undefined      ' action  make capsable
txt=32
text$ = ""
numdead=0
nummod=0
maxdead   =  3
clr(modkey) =  lightgrey
clr(dedkey) =  lightgrey
clr(textkey) = black
kd    = undefined        'dedkey's keycode
km    = undefined        'modkey's keycode
kh    = undefined
qd    = 0                'dedkey's qualstate
qm    = 0                'modkey's qualstate
helpstatus = inactive
s$ = ""                  'queue for Ctrl-C
FOR i=0 TO 103
  typ(i)=0
  keys(capsable,i,0) = BLUE
  keys(repeatable,i,0) = BLUE
  keys(mustextract,i,0) = blue.blue.red  'since we default to ??
  FOR j=1 TO 15
    keys(mustextract,i,j) = black.black.black
  NEXT j
NEXT i
FOR i=1 TO maxmod
  modi$(i)=""
NEXT i
FOR i=0 TO maxdead
  deadcount(i)=0
  deadcode(i)=0
NEXT i
st=state:IF st>3 THEN st=3
FOR i=  0 TO 103
  clr(i)=clrextract(state,keys(st,i,0))
  FOR j=0 TO 15
    a$(i,j) = "??"
  NEXT j
NEXT
nil=FRE(0)
FOR i=120 TO 136:clr(i)=black  :NEXT
clr(120)=red
FOR i=121 TO 124:clr(i)=BLUE:NEXT
clr(actionkey) = BLUE
FOR i=129 TO 131:clr(i)=black:NEXT
FOR i=132 TO 135:clr(i)=black:NEXT
FOR a=0 TO 103
    z=clr(a)
    GOSUB paintkey
NEXT a
FOR a=120 TO 135
    IF a=124 THEN LINE(ulx(124),uly(124))-(lrx(124),lry(124)),,b
    z=clr(a)
    GOSUB paintkey
NEXT a
COLOR black,green
LOCATE 18,27:PRINT "    ";   'Could be Mod or Use
LOCATE 18,36:PRINT ml$(q);
GOSUB erasededkey
GOSUB actionchange
nil=FRE(0)
GOSUB clearlineone
COLOR white,green:LOCATE 1,1:PRINT "Ready to go"
MENU 1,0,1
MENU ON
MOUSE ON
RETURN
REM ********************************************************
mainloop:
REM ********************************************************   
 IF s$<>"" THEN  
   r$=s$:s$=""
 ELSE
   r$=INKEY$
 END IF
 IF r$ <> "" THEN
   IF clr(textkey)=lightblue OR clr(textkey)=lightred THEN
    GOSUB texth
   ELSE
    BEEP
   END IF
 END IF
 nil=FRE(0)
 SLEEP
 GOTO mainloop
 
timeslice:
  COLOR red,white:LOCATE 20,10
  PRINT cdt;
  cdt=cdt-1
  COLOR 1,0
  IF cdt<0 THEN LOCATE 20,10:PRINT "    ";:TIMER OFF
  RETURN 

keydata:
DATA  0, 15, 24, 45, 40,   `
DATA  1, 45, 24, 75, 40,   1
DATA  2, 75, 24,105, 40,   2
DATA  3,105, 24,135, 40,   3
DATA  4,135, 24,165, 40,   4
DATA  5,165, 24,195, 40,   5
DATA  6,195, 24,225, 40,   6
DATA  7,225, 24,255, 40,   7
DATA  8,255, 24,285, 40,   8
DATA  9,285, 24,315, 40,   9
DATA 10,315, 24,345, 40,   0
DATA 11,345, 24,375, 40,   -
DATA 12,375, 24,405, 40,   =
DATA 13,405, 24,435, 40,   \
REM  14 is undefined
REM  15 is on keypad
DATA 15,510, 72,570, 88,   0 p 
DATA 16, 60, 40, 90, 56,   q
DATA 17, 90, 40,120, 56,   w
DATA 18,120, 40,150, 56,   e
DATA 19,150, 40,180, 56,   r
DATA 20,180, 40,210, 56,   t
DATA 21,210, 40,240, 56,   y
DATA 22,240, 40,270, 56,   u
DATA 23,270, 40,300, 56,   i
DATA 24,300, 40,330, 56,   o
DATA 25,330, 40,360, 56,   p
DATA 26,360, 40,390, 56,   [
DATA 27,390, 40,420, 56,   ]
REM  28 is undefined
REM 29-31 are on keypad
DATA 29,510, 56,540, 72,   1 p
DATA 30,540, 56,570, 72,   2 p
DATA 31,570, 56,600, 72,   3 p
DATA 32, 75, 56,105, 72,   a
DATA 33,105, 56,135, 72,   s
DATA 34,135, 56,165, 72,   d
DATA 35,165, 56,195, 72,   f
DATA 36,195, 56,225, 72,   g
DATA 37,225, 56,255, 72,   h
DATA 38,255, 56,285, 72,   j
DATA 39,285, 56,315, 72,   k
DATA 40,315, 56,345, 72,   l
DATA 41,345, 56,375, 72,   ;
DATA 42,375, 56,405, 72,   '
REM  43 and 44 are undefined
REM 45-47 are on keypad
DATA 45,510, 40,540, 56,   4 p
DATA 46,540, 40,570, 56,   5 p
DATA 47,570, 40,600, 56,   6 p
REM  48 is undefined
DATA 49, 90, 72,120, 88,   z
DATA 50,120, 72,150, 88,   x
DATA 51,150, 72,180, 88,   c
DATA 52,180, 72,210, 88,   v
DATA 53,210, 72,240, 88,   b
DATA 54,240, 72,270, 88,   n
DATA 55,270, 72,300, 88,   m
DATA 56,300, 72,330, 88,  ","
DATA 57,330, 72,360, 88,   .
DATA 58,360, 72,390, 88,   /
REM  59 is undefined
REM 60 is on keypad
DATA 60,570, 72,600, 88,   . p
DATA 61,510, 24,540, 40,   7 p
DATA 62,540, 24,570, 40,   8 p
DATA 63,570, 24,600, 40,   9 p
DATA 64,120, 88,360,104,   sp
DATA 65,435, 24,480, 40,   bac
DATA 66, 15, 40, 60, 56,   tab
DATA 67,540, 88,600,104,   ent
REM 68 is a special case   return
REM we use 68 and 71 to cover it
DATA 68,420, 40,450, 72,   ret
DATA 69, 15,  8, 45, 24,   Esc
DATA 70,450,  8,480, 24,   Del
REM  71, 72, 73, 75 undefined
DATA 71,405, 56,450, 72,   "  return kludge"
REM 74 is on the pad
DATA 74,510, 88,540,104,   - p
DATA 76,450, 56,480, 72,   up 
DATA 77,450, 88,480,104,   dwn 
DATA 78,465, 72,495, 88,   rig
DATA 79,435, 72,465, 88,   lef
DATA 80, 60,  8, 90, 24,   F1
DATA 81, 90,  8,120, 24,   F2
DATA 82,120,  8,150, 24,   F3
DATA 83,150,  8,180, 24,   F4
DATA 84,180,  8,210, 24,   F5
DATA 85,270,  8,300, 24,   F6
DATA 86,300,  8,330, 24,   F7
DATA 87,330,  8,360, 24,   F8
DATA 88,360,  8,390, 24,   F9
DATA 89,390,  8,420, 24,   F10
REM 90, 91, 92, 93, 94 undefined
DATA 95,450, 40,480, 56,   Hlp
DATA 96, 15, 72, 90, 88,   SHl
DATA 97,390, 72,435, 88,   SHr
DATA 98, 45, 56, 75, 72,   cap
DATA 99, 15, 56, 45, 72,   CTL
DATA 100, 60, 88, 90,104,  ALl
DATA 101,390, 88,420,104,  ALr
DATA 102, 90, 88,120,104,  A l
DATA 103,360, 88,390,104,  A r
REM  104 to 119 undefined
DATA 120, 15,112,105,144,  Capsable
DATA 121,105,112,195,144,  Repeatable
DATA 122, 15,144,105,176,  Deadkeys
DATA 123,105,144,195,176,  Modifiable
DATA 124, 60,128,150,160,  Keymap
REM  next two, 125 and 126, are deadkey and modkey
DATA 125,240,112,275,128,  ? 
DATA 126,240,136,275,152,  ? 
DATA 127,240,158,520,178,  This is a   32  character string
DATA 128,435,112,525,144,  ActionKey
REM delete: DATA 129,525,  0,600, 16,  Downup
DATA 130,525,112,630,144,  Cycle Qualifiers
DATA 131,525,144,630,176,  Cycle Active Qualifiers
DATA 132,494,  0,524, 16,  DO
DATA 133,524,  0,554, 16,  CT
DATA 134,554,  0,584, 16,  AL
DATA 135,584,  0,615, 16,  SH
DATA 136,  0,  0,800,200,  Outrageous
DATA -1,-1,-1,-1,-1,       end of data

subgetkeycode:
SUB getkeycode(k,x,y) STATIC
SHARED true, false
found = false
k=-1
i=0
WHILE NOT found
   IF uly(i) > y  THEN GOTO iterate
   IF ulx(i) = -1 THEN GOTO iterate
   IF lry(i) <= y THEN GOTO iterate
   IF ulx(i) > x  THEN GOTO iterate
   IF lrx(i) <= x THEN GOTO iterate 
   found = true
   k=i
   IF i=71 THEN k=68
iterate: i=nxt(i)  
WEND
IF i=137 THEN k=-1  'remember, we iterated i
                    'also, remember that i=136 is certain to succeed
END SUB

paintkey:
REM paint key with code a color z
  IF a=71 THEN RETURN  'never color bottom of return key separately
  LINE(ulx(a)+1,uly(a)+1)-(lrx(a)-1,lry(a)-1),z,bf
  IF a=68 THEN LINE(ulx(71)+1,uly(71)+1)-(lrx(71)-1,lry(71)-1),z,bf
  yp=texy(a) :  xp=texx(a)
  LOCATE yp,xp
  COLOR 1,z
  IF a < 120 THEN
   PRINT c2$(a);:RETURN
  ELSEIF (a=122) OR (a=123) THEN  'Deadkeys or Modifiable
   LOCATE yp+2,xp
   PRINT C$(a);
  ELSEIF (a=actionkey)  THEN
   PRINT MID$(C$(a),1,10);
   LOCATE yp+1,xp
   PRINT MID$(C$(a),11,10);
  ELSEIF (a=130) OR (a=131) THEN
   LOCATE yp,xp
   PRINT "Cycle";
   LOCATE yp+1,xp
   IF a=131 THEN PRINT "Active";:LOCATE yp+2,xp
   PRINT "Qualifiers";
  ELSEIF (a=textkey) THEN
   texty=texty-1
   CALL printt(C$(a),1)
   texty=texty+1
   COLOR 1,z:LOCATE yp,xp:PRINT SPACE$(32);
  ELSE
   PRINT C$(a);
  END IF
RETURN

setupnum:
 RESTORE numdata  
 FOR j=0 TO 15
  READ num(j)
  NEXT j
 FOR i=1 TO 16
  FOR j=0 TO 15
  READ use(i,j)
 NEXT j:NEXT i 
numdata:
REM cols. 0-7 correspond to the low hex
REM  digit of the keytype
REM entries of 99 mean "don't care"
DATA  1, 2, 2, 4, 2, 4, 4, 8, 2, 4, 4, 8, 4, 8, 8,16
DATA  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 99, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1
DATA 99,99,99, 2,99, 4, 4, 2,99, 8, 8, 2, 8, 4, 4, 2
DATA 99,99,99, 3,99, 5, 6, 3,99, 9,10, 3,12, 5, 6, 3
DATA 99,99,99,99,99,99,99, 4,99,99,99, 8,99, 8, 8, 4
DATA 99,99,99,99,99,99,99, 5,99,99,99, 9,99, 9,10, 5
DATA 99,99,99,99,99,99,99, 6,99,99,99,10,99,12,12, 6
DATA 99,99,99,99,99,99,99, 7,99,99,99,11,99,13,14, 7
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 8
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 9
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,10
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,11
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,12
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,13
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,14
DATA 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,15
RETURN

subopenup: 
    GOSUB clearlineone
    LOCATE 1,1:COLOR 1,0:PRINT "Read ";fff$;
    ON ERROR GOTO diskerrorh:errno=0
    OPEN fff$ FOR INPUT AS 1
    IF errno <> 0 THEN ON ERROR GOTO 0:WINDOW OUTPUT 2:RETURN
    RESTORE filedata
REM *****************************************************    
REM read hunk-header,length,start of next hunk, length
    FOR i=1 TO 5*4
      x$=INPUT$(1,#1)
      READ b
filedata:
DATA  0,0,3,243,0,0,0,0,0,0,0,1,0,0,0,0
DATA  0,0,0,0          
      IF ASC(x$) <> b THEN
         GOTO abort
      END IF
    NEXT i
REM ******************************************************    
REM read length of file    
    x$=INPUT$(4,#1)   
    filelength = CVL(x$)*4
    header = 10+36+15+15+120
    IF filelength-1 > buffreserved THEN
       LOCATE 1,1:COLOR white,green
       PRINT "Sorry, not enough buffer space reserved for this keymap.";
       CLOSE #1:ON ERROR GOTO 0:RETURN
    END IF
    y$=INPUT$(4,#1)      'read 0,0,3,233
    z$=INPUT$(4,#1)      'should be length of file
    IF y$ <> CHR$(0)+CHR$(0)+CHR$(3)+CHR$(233) THEN abort
    IF z$ <> x$ THEN abort
REM ********************************************************
REM read table
    FOR i=0 TO filelength-1
      buff(i) = ASC(INPUT$(1,#1))
    NEXT i
REM *******************************************************                     
REM next 4 bytes should be hunk-reloc
    x$=INPUT$(4,#1)
    IF x$ <> CHR$(0)+CHR$(0)+CHR$(3)+CHR$(236) THEN
       GOSUB clearlineone:LOCATE 1,1:COLOR white,green
       PRINT "Did not find hunk-reloc where expected.";
       CLOSE#1:ON ERROR GOTO 0:RETURN
    END IF
REM ********************************************************
LOCATE 1,1:COLOR 1,0:PRINT "file ";f$;" read.  Now processing ...";
CLOSE#1
ON ERROR GOTO 0
REM ********************************************************
REM  initialize
GOSUB clearlineone
LOCATE 1,1:PRINT "                      first pass";
FOR i=1 TO nummod
  modi$(i)=""
NEXT i  
nummod=0
numdead=0
FOR i=0 TO maxdead
  deadcount(i)=0
  deadcode(i)=0
NEXT i
FOR i=0 TO 103
   FOR j= 0 TO 15
  keys(mustextract,i,j) = black.black.black
  NEXT j
  LOCATE 1,1:PRINT i;"     ";
NEXT i
nil=FRE(0)
LOCATE 1,1:PRINT "                      second pass";
REM interpret table
    FOR i=0 TO 9
       IF buff(i) <> 0 THEN GOTO abort
    NEXT i    
REM read 9 addresses
    FOR i=0 TO 4*9-1
      x=buff(i+10)  'skip past ten zeroes
    NEXT i
REM interpret caps table
    j=0
    FOR i=0 TO 14
       x=buff(i+10+36) 'skip front stuff
       FOR d=0 TO 7
           y=x AND 1
           IF y=0 THEN keys(capsable,j,0) = BLUE :ELSE keys(capsable,j,0) = red
           j = j+1
           x = (x-y)/2
       NEXT d
    NEXT i
REM interpret repeat table
    j=0
    FOR i=0 TO 14
      x=buff(i+10+36+15)
      FOR d=0 TO 7
          y=x AND 1
          IF y=0 THEN keys(repeatable,j,0) = BLUE :ELSE keys(repeatable,j,0) = red
          j = j + 1
          x = (x-y)/2
      NEXT d
    NEXT i 
REM interpret keytype table
    FOR i=0 TO 119
       x=buff(i+10+36+15+15)
       typ(i)=x
    NEXT i
REM now set up the keymap
  FOR i=0 TO 119
    hihex=(typ(i) AND 240)/16   
    lohex=typ(i) AND 15
    IF (hihex AND 8) <> 0 THEN 'undefined key
       typ(i)=undefined
       GOTO wayout
    ELSEIF (hihex AND 2) <> 0 THEN 'dead bit
       typ(i)=lohex:C=num(lohex)
       x$ = CHR$(buff(4*i+header))+CHR$(buff(4*i+header+1))+CHR$(buff(4*i+header+2))+CHR$(buff(4*i+header+3))
       add=CVL(x$)
       FOR j=0 TO 2*C-1
         d(j)=buff(add+j)
       NEXT j
       FOR j=0 TO C-1
        IF d(2*j)=0 THEN
           x$=CHR$(d(2*j+1))
           u = use(j+1,typ(i) AND 15)
           a$(i,u) = x$
           keys(mustextract,i,u) = blue.blue.hardblue
        ELSEIF d(2*j)=1 THEN   'modifiable key
           'make it identifiable in second pass
           typ(i) = lohex OR 16
           u = use(j+1,typ(i) AND 15)
           keys(mustextract,i,u) = blue.red.hardblue       
        ELSEIF d(2*j)=8 THEN   'dead key
           u = use(j+1,typ(i) AND 15)
           CALL adddeadkey(i,u,d(2*j+1),errcode)
        ELSE
          LOCATE 1,1:COLOR white,green
          PRINT "***Abort***";
          RETURN
        END IF
       NEXT j
       GOTO wayout  
    ELSEIF hihex=0  THEN     'ordinary key
       IF (lohex=11) OR (lohex >=13) THEN 'direct
          typ(i) = lohex:C=num(lohex)
          x$=CHR$(buff(header+4*i))+CHR$(buff(header+4*i+1))+CHR$(buff(header+4*i+2))+CHR$(buff(header+4*i+3))
          add=CVL(x$)
          FOR j=0 TO C-1
            x$=CHR$(buff(add+j))
            u=use(j+1,lohex)
            a$(i,u)=x$
            keys(mustextract,i,u) = blue.blue.softblue
          NEXT j
       ELSEIF lohex <> 7 THEN        'immediate
          typ(i) = lohex:C=num(lohex)
          FOR j=0 TO C-1
             x$=CHR$(buff(4*i+header+3-j))
             u=use(j+1,lohex)
             a$(i,u) = x$
             keys(mustextract,i,u) = blue.blue.softblue
          NEXT j
       ELSE            'vanilla key   lohex=7
          typ(i)=7
          FOR j=0 TO 3
              x$=CHR$(buff(4*i+header+3-j))
              z$=CHR$(ASC(x$) AND 159)
              a$(i,j) = x$
              a$(i,j+4) = z$
              keys(mustextract,i,j) = blue.blue.softblue
              keys(mustextract,i,j+4) = blue.blue.softblue
          NEXT j
       END IF
       GOTO wayout
    ELSEIF hihex=4 THEN    'string
       typ(i) = lohex
       C = num(lohex)
       x$ = CHR$(buff(4*i+header))+CHR$(buff(4*i+header+1))+CHR$(buff(4*i+header+2))+CHR$(buff(4*i+header+3))
       add = CVL(x$) 
       REM add       
       REM array d holds the 2,4,6,8,10,12,14,or 16 byte string descriptor
       FOR j=0 TO 2*C-1
         d(j) = buff(add+j)
       NEXT j
       REM now assign the strings!
       FOR j=0 TO C-1
          x$=""
          FOR h=add+d(2*j+1)  TO add+d(2*j+1)+d(2*j)-1
              x$=x$+CHR$(buff(h))
          NEXT h
          u = use(j+1,typ(i))
          a$(i,u) = x$
          keys(mustextract,i,u)= blue.blue.red 
       NEXT j
       GOTO wayout
    ELSE
       LOCATE 1,1:COLOR white,green
       PRINT "Keycode ";i;" is of unknown keytype ";typ(i)
       PRINT "***Abort***";
       GOSUB newk:RETURN
    END IF
wayout:    
  LOCATE 1,1:PRINT i;"          "
  NEXT i
GOSUB clearlineone:LOCATE 1,1:PRINT "                      Third pass"  
REM second pass, in which we handle modifiable keys
REM we can identify the keycodes by their typ   
  FOR i=0 TO 119
    IF (typ(i) AND 16) <> 0 THEN
       typ(i)= typ(i) AND 15
       LOCATE 1,1:PRINT "redoing ";i;"       ";
       x$ = CHR$(buff(4*i+header))+CHR$(buff(4*i+header+1))+CHR$(buff(4*i+header+2))+CHR$(buff(4*i+header+3))
       add=CVL(x$)
       C=num(typ(i))
       FOR j=0 TO C-1
         d(j) = buff(add+j)
       NEXT j
       FOR j=0 TO C-1
         IF d(2*j)=1 THEN   'modifiable key
            u=use(j+1,typ(i))
            x$=""
            FOR m=0 TO numdead
              x$=x$ + CHR$(buff(add + d(2*j+1) + m))
            NEXT m
            nummod=nummod+1
            modi$(nummod) = x$
            a$(i,u) = CHR$(nummod)
         END IF
       NEXT j
    END IF
  NEXT i
GOSUB clearlineone:LOCATE 1,1:PRINT "All finished   "  
  RETURN
abort:
   LOCATE 1,1:COLOR white,green
   PRINT "I cannot recognize ";f$;" as a keymap. ";
   PRINT "***Abort***";
RETURN

deadkeyh:
SUB deletedeadkey(k,q) STATIC
SHARED maxdead,numdead,mustextract,maxmod,nummod,blue.blue.softblue
  j=ASC(a$(k,q))
  IF deadcount(j) = 1 THEN 'whole way of life ends
     deadcount(j)=0
     dc=deadcode(j)
     deadcode(j)=0
     IF dc < numdead THEN
       FOR m=0 TO maxdead - 1 'codes are always an initial segment 1..numdead
         IF deadcode(m) > dc THEN deadcode(m)=deadcode(m)-1
       NEXT m
     END IF
     numdead = numdead - 1
     keys(mustextract,k,q) = blue.blue.softblue
     a$(k,q)=" "
     FOR m=1 TO nummod
       modi$(m) = MID$(modi$(m),1,dc-1) +  MID$(modi$(m),dc+1,LEN(modi$(m))-dc)
     NEXT m
  ELSE       'a clone remains
     deadcount(j)=deadcount(j)-1
     keys(mustextract,k,q)=blue.blue.softblue
     a$(k,q)=" "
  END IF
END SUB

SUB adddeadkey(k,q,dcode,errcode) STATIC
SHARED red.blue.hardblue ,numdead,nummod ,mustextract
SHARED maxdead
  WINDOW OUTPUT 1:PRINT "add deadkey #",k;" ";C$(k);" q=";q;" dcode=";dcode
  REM keycode k, qualstate q wants to be a deadkey
  REM if dcode > 0 then it wants dcode to be its code
  REM do this only if you know what you're doing,
  REM because this wish is always honored
  errcode = 0  'assume ok till proven otherwise
  IF dcode > 0 THEN
     REM see if we're just cloning an existing deadkey
     j=0
     WHILE (j<maxdead) AND (deadcode(j) <> dcode)
        j=j+1
     WEND
     IF j<maxdead THEN  'deadcode(j)=dcode
       keys(mustextract,k,q)=red.blue.hardblue
       deadcount(j)=deadcount(j)+1
 PRINT "clone of ";j;"  EXIT":WINDOW OUTPUT 2      
       a$(k,q) = CHR$(j)
       EXIT SUB
     ELSE
       'fall through to next section
     END IF
  END IF
  REM first find an open slot in deadcount array
  j=0
  WHILE deadcount(j) <> 0  'guaranteed success at j=maxdead
    j=j+1
  WEND  
  IF j=maxdead THEN
     IF maxdead=topdead THEN
       COLOR 1,0:LOCATE 1,1:PRINT "Sorry, I have no room to remember deadkeys.";
       errcode=-1
       EXIT SUB
     ELSE
       maxdead=maxdead+1
       deadcode(maxdead)=0
       deadcount(maxdead)=0
     END IF  
  END IF
  REM  j<maxdead and is an open slot
  deadcount(j)=1
  IF dcode > 0 THEN
     deadcode(j)=dcode
     IF dcode > numdead THEN numdead=dcode
  ELSE
     numdead=numdead+1
     deadcode(j)=numdead
     FOR i=1 TO nummod                      'new in 48
       modi$(i)=modi$(i)+MID$(modi$(i),1,1)
     NEXT i
  END IF
  keys(mustextract,k,q) = red.blue.hardblue
  a$(k,q)=CHR$(j) 
  PRINT "numdead=";numdead;"EXIT"
  WINDOW OUTPUT 2
END SUB
  
leftmouse:
  t=MOUSE(0)
  x=MOUSE(1)
  y=MOUSE(2)
  CALL getkeycode(k,x,y)
  IF k=-1 THEN
   BEEP:GOSUB clearlineone
  ELSEIF k < 120 THEN   'keyboard
     GOSUB clearlineone
     GOSUB keyboard
  ELSE  
    GOSUB clearlineone
    IF clr(k)=black THEN BEEP:RETURN
    ON (k-119) GOTO opth,opth,opth,opth,opth
    ON (k-124) GOTO nowhere,nowhere,nowhere,actionh,nowhere
    ON (k-129) GOTO cycleh,cycleh,qualh,qualh,qualh,qualh
  END IF
  RETURN
  
nowhere:
  BEEP:RETURN  
keyboard:
    IF k=kh THEN 
       'do nothing
    ELSE
      GOSUB highlightk     'Highlight new key (and bottom key)
      GOSUB textchange     'fix text
      GOSUB actionchange
    END IF
  RETURN
  
highlightk:
  IF kh <> undefined THEN
    z=reverse(clr(kh))  'In these 3 lines
    a=kh
    GOSUB paintkey      '   we "unhighlight" the previous
    clr(kh)=z           '   highlighted key
  END IF
  z=reverse(clr(k))
  a=k
  GOSUB paintkey
  clr(k)=z
  kh = k
REM copy result to modkey or dedkey as appropriate
IF (state <> deadkeys) THEN
  C$(modkey)=C$(k)
  a=modkey 
  GOSUB paintkey  
  clr(modkey)=z
ELSE    'state = deadkeys
  C$(dedkey)=C$(k)
  a=dedkey
  GOSUB paintkey
  clr(dedkey)=z
END IF
  RETURN
  
opth:
  newstate = k-119
  IF (newstate <  3) AND (state >= 3) THEN GOSUB qualoff
  IF (newstate >= 3) AND (state <  3) THEN GOSUB qualon 
  IF newstate=state THEN
    'do nothing
  ELSE
    REM fix colors of option selectors 
      z=otherchoice(clr(119+state))
      IF state <> 5 THEN a=119+state:GOSUB paintkey
      clr(119+state)=z
      z = otherchoice(clr(119+newstate))
      a=119+newstate
      GOSUB paintkey
      clr(119+newstate)=z     
      IF newstate <> 5 THEN
         a=124:z=clr(124)
         GOSUB paintkey  'keymap key
      END IF
      COLOR 1,0:LINE(ulx(124),uly(124))-(lrx(124),lry(124)),,b 
  END IF
  oldstate=state
  state=newstate
  IF (state=deadkeys) AND (kd<>undefined) AND (q<>qd) THEN q=qd:GOSUB showqual    
  GOSUB repaintkeytops
  ON state GOSUB nondead,nondead,dead,nondead,nondead
  RETURN
nondead:
  IF oldstate <> deadkeys THEN
     'do nothing
  ELSEIF kd <> undefined THEN
        clr(dedkey)=reverse(clr(dedkey)) 'unhighlight dedkey
        a=dedkey:z=clr(dedkey)       
        GOSUB paintkey
  END IF
  GOSUB textchange
  GOSUB actionchange
  RETURN  
dead:
  IF (kd <> undefined) THEN
     k=kd
     GOSUB highlightk
     IF km <> undefined THEN   'unhighlight modkey
       clr(modkey)=reverse(clr(modkey))
       a=modkey:z=clr(modkey)
       GOSUB paintkey
     END IF
     clr(dedkey) = reverse(clrextract(deadkeys,keys(mustextract,kd,qd)))
     GOSUB drawdedkey
  ELSEIF (kh <> undefined) THEN
     kd = kh
     qd = q
     IF km <> undefined THEN   'unhighlight modkey
       clr(modkey)=reverse(clr(modkey))
       a=modkey:z=clr(modkey)
       GOSUB paintkey
     END IF
     C$(dedkey) = C$(kd)
     clr(dedkey) = reverse(clrextract(deadkeys,keys(mustextract,kd,qd)))
     GOSUB drawdedkey
  END IF
  GOSUB textchange   'does this work
  GOSUB actionchange
  RETURN  
RETURN

repaintkeytops:
  qqq=q:IF state < 3 THEN qqq = 0
  st=state:IF st>3 THEN st=3
  keys(st,71,qqq)=keys(st,68,qqq) 
  FOR i=0 TO 103
  IF ulx(i) <> -1 THEN
     z = clrextract(state,keys(st,i,qqq))
     IF i=kh OR (i=71 AND kh=68) THEN z=reverse(z)
     LINE(ulx(i)+1,uly(i)+1)-(lrx(i)-1,lry(i)-1),z,bf
     clr(i)=z
  END IF
  NEXT i
  IF kh <> undefined THEN 
     REM only need to redo key if key active and color changed
     REM or if state has changed
     z=clrextract(state,keys(st,kh,qqq))
     z=reverse(z)
     IF (state <> deadkeys) AND ((z <> clr(modkey)) OR ((120<=k) AND (k<=124))) THEN
        a=modkey
        GOSUB paintkey
        clr(modkey)=z
     END IF
     IF (z <>clr(dedkey)) AND (state = deadkeys) THEN
        a=dedkey
        GOSUB paintkey
        clr(dedkey)=z
     END IF
  END IF
  RETURN  

modh:
  BEEP
  RETURN
  
menuh:
    t=MENU(0)
    GOSUB clearlineone
    ON MENU(1) GOTO newk,choice1,choice2,about,quith
newk:
  COLOR white,green:LOCATE 1,1:PRINT "Resetting keymap...";
  GOTO statevariables
choice1:    
  WINDOW 3,"LOAD KEYMAP",(10,20)-(400,75),0,1
  MOUSE OFF:MENU OFF:MENU 1,0,0
emptyinkey1:
  IF INKEY$<>"" THEN emptyinkey1
  PRINT "Load what file? "
  IF f$<>"" THEN PRINT "Default is ";f$ :ELSE PRINT
  LINE INPUT ff$
  IF ff$<>"" THEN fff$=ff$ :ELSE fff$=f$
  PRINT "Loading keymap ";fff$;"?"
  PRINT "Press RETURN to accept, any other key to cancel"
getkey:
  r$=INKEY$:IF r$ ="" THEN getkey
  WINDOW CLOSE 3
  MOUSE ON:MENU ON:MENU 1,0,1
  GOSUB clearlineone
  IF r$=CHR$(13) THEN
     f$=fff$
  ELSE
     COLOR white,green:LOCATE 1,1:PRINT "Cancelled":RETURN
  END IF
  COLOR white,green:LOCATE 1,1:PRINT "loading keymap... ";f$
    fff$="devs:keymaps/" + f$
    GOSUB subopenup
    GOSUB textchange
    GOSUB repaintkeytops
    GOSUB actionchange
    BEEP
    RETURN
choice2:
    COLOR white,green:LOCATE 1,1:PRINT "saving keymap..."
    GOTO savekeymap
about:
    MOUSE OFF
    MENU 1,0,0
    nil=FRE(0)
    WINDOW 3,"About Keybird  (the keybird enhancer) Version 1.0",(0,8)-(631,186),16,1
    LOCATE 1,1:COLOR red,white
    FOR i=1 TO 23:PRINT SPACE$(80):NEXT
    LOCATE 1,1  
    PRINT "Default keymap keybird operates on is usa2 (a Dvorak keyboard)"
    PRINT "  To get the Workbench 1.2 default keymap, use Thisisusa;"
    PRINT "  make sure you have copied it into the devs:keymaps directory."
    PRINT "There is a bug in the console.device which causes what you GET from the"
    PRINT " keyboard to differ from what Keytoy (Extras 1.2 disk, Tools drawer)"
    PRINT " says you should get.  (Example: CTRL+ALT+B )"
    PRINT " In this Version, we show what Keytoy says you should get. "
    PRINT "When typing into the text box at the bottom of the screen,"
    PRINT " you cannot exceed one character if the highlighted key "
    PRINT " controls a deadkey or modifiable key."
    PRINT "Type Help-Alphabetic character to get a high control key (shown in RED)"
    PRINT "Type Control-Alphabetic character to get ordinary control keys (shown in BLUE)"
    PRINT "Exceptions:  Type Help-Shift-C TO GET Control-C.   (shown in BLUE)"
    PRINT "             Type Help-Shift-S to get Control-S.   (shown in BLUE)"
    PRINT "             Type Help-Shift-M to get Control-M.   (shown in BLUE)"
    PRINT "             Type Help-Shift-H to get Control-H.   (shown in BLUE)"
    PRINT "WARNING:  Typing Control-S puts the program to sleep!!!!!"
    PRINT "  Type any character to wake it up again!"
    PRINT "Note that program may respond sluggishly to mouse clicks until it warms up.
    PRINT "Copyright ";CHR$(169);" 1987 by Michael A. Ingrassia, Amicus/HV.  All rights reserved."
    PRINT "   Licensed for non-commercial distribution (freeware)."
    PRINT "Press <RETURN> to continue.";
getkey3:
    r$=INKEY$:IF r$="" THEN getkey3
    WINDOW CLOSE 3
    MOUSE ON
    MENU 1,0,1
    RETURN          

actionh:
  a=actionkey
  ON action     GOTO action1,action2,action3,action4,action5,action6
  ON (action-6) GOTO action7,action8,action9,action10,action11,action12
  STOP
action1: 'make capsable
  keys(capsable,kh,0)=red
  clr(kh)=lightred
  GOTO cleanup
action2: 'make NOT capsable
  keys(capsable,kh,0)=BLUE
  clr(kh)=lightblue
  GOTO cleanup
action3: 'make repeatable
  keys(repeatable,kh,0)=red
  clr(kh)=lightred
  GOTO cleanup
action4:  'make NOT repeatable
  keys(repeatable,kh,0)=BLUE
  clr(kh)=lightblue
  GOTO cleanup
action5: 'make deadkey
  LOCATE 1,1:PRINT "adding this deadkey   ";
  CALL adddeadkey(kh,q,0,errcode)
  IF errcode=-1 THEN BEEP:RETURN 
  k=kh:GOSUB stalkcheck
  clr(kh)=lightred
  GOTO cleanup
action6: 'make NOT deadkey
  LOCATE 1,1:PRINT "working on not deadkey";
  CALL deletedeadkey(kh,q)
  k=kh:GOSUB stalkcheck
  clr(kh)=lightblue
  GOTO cleanup
action7:  'make modifiable
  k=kh:GOSUB stalkcheck
  IF clrextract(keymap,keys(mustextract,kh,q)) <> BLUE THEN
     COLOR white,green:LOCATE 1,1
     PRINT "No can do! With some qualifiers this key produces strings!"
     BEEP:RETURN
  END IF
  REM  get next slot in modi$
  m=1
  WHILE LEN(modi$(m)) > 0
    m = m+1
  WEND
  REM at this point len(mod$(m)) = 0
  IF m = maxmod THEN
     COLOR white,green:LOCATE 1,1
     PRINT "How embarrassing! There's no room for another modifiable key!";
     BEEP:RETURN
  ELSEIF m=nummod+1 THEN
     nummod = nummod+1
  END IF
  m$ = MID$(a$(kh,q),1,1)
  modi$(m) = m$
  FOR i=1 TO numdead
      modi$(m) = modi$(m) + m$
  NEXT i
  nil=FRE(0)
  a$(kh,q) = CHR$(m)
  keys(mustextract,kh,q)=blue.red.hardblue
  clr(kh)=lightred
  GOTO cleanup
action8:  'make NOT modifiable
  REM just delete this slot,then redefine nummod if necessary
  m=ASC(a$(kh,q))
  a$(kh,q)=MID$(modi$(m),1,1)
  modi$(m) = ""
  WHILE LEN(modi$(nummod))=0
    nummod=nummod-1
  WEND 
  keys(mustextract,kh,q)=blue.blue.hardblue 'or should it be softblue?
  clr(kh)=lightblue
  k=kh:GOSUB stalkcheck
  GOTO cleanup
action9:  'make active
  IF typ(kh)=undefined THEN
     typ(kh)=0
     keys(mustextract,kh,0)=blue.blue.red
  END IF
  FOR m=0 TO 3
   b=exp2(m)
   IF ((q AND b) <> 0) AND ((typ(kh) AND b) = 0) THEN
       FOR j=1 TO num(typ(kh))
         u = use(j,typ(kh)) + b
         keys(mustextract,kh,u) = blue.blue.red
       NEXT j
       typ(kh)=typ(kh)+b
   END IF
  NEXT m
  clr(kh)=reverse(clrextract(keymap,keys(mustextract,kh,q)))
  k=kh:GOSUB stalkcheck
  GOTO cleanup
action10:  'make NOT active
  FOR j=1 TO num(typ(kh)-q) 'kh may be undefined!?
    u=use(j,typ(kh)-q) + q
    IF (keys(mustextract,kh,u)=red.blue.hardblue) OR (keys(mustextract,kh,u)=blue.red.hardblue)  THEN GOTO sorry
  NEXT j
  typ(kh)=typ(kh)-q
  IF q=0 THEN 
     typ(kh)=undefined  
     keys(mustextract,kh,0)=black.black.black
  ELSE   
   FOR j=1 TO num(typ(kh))
     u=use(j,typ(kh)) + q
     keys(mustextract,kh,u)=black.black.black
   NEXT j
  END IF
  k=kh:GOSUB stalkcheck
  clr(kh)=lightgrey
  GOTO cleanup
  sorry:
    COLOR white,green:LOCATE 1,1
    PRINT "This keycap controls an active deadkey or modifiable key!"
    action=11:clr(actionkey)=black
    C$(actionkey)=actionmsg$(action)
    a=actionkey:z=clr(actionkey):GOSUB paintkey
    BEEP
    RETURN
  RETURN
action11:BEEP:RETURN   'unreachable, actually
action12:              'Make clone of deadkey
  LOCATE 1,1:PRINT "Cloning deadkey ";C$(km);" ";ml$(qm);
  CALL adddeadkey(kh,q,deadcode(ASC(a$(km,qm))),errcode)
  IF errcode=-1 THEN BEEP:RETURN
  clr(kh)=lightred
  GOTO cleanup
cleanup:
  a=kh:z=clr(kh)
  GOSUB paintkey 
  GOSUB textchange
  GOSUB actionchange
  GOSUB clearlineone
  RETURN
  
clearlineone:
  COLOR white,green:LOCATE 1,1
  PRINT SPACE$(61)
  RETURN  

stalkcheck:
REM paint the stalk for k the proper color
  IF k=undefined THEN RETURN
  z=blue.blue.softblue    'default color
  allshouldbered = false
  allshouldbehardblue = false
  C=num(typ(kh) AND 15)  'may be called from savekeymap???
  j=0
  WHILE j < C
    u=use(j+1,typ(kh) AND 15)
    kk=keys(mustextract,k,u)
    IF LEN(a$(k,u)) > 1 THEN allshouldbered=true
    IF kk=red.blue.hardblue THEN allshouldbehardblue=true
    IF kk=blue.red.hardblue THEN allshouldbehardblue=true    
    j=j+1
  WEND
  IF allshouldbehardblue AND allshouldbered THEN
     REM  this could happen since stalks grow dynamically
     j=0:C=num(typ(kh) AND 15)
     WHILE j < C
       u=use(j+1,typ(kh) AND 15)
       kk=keys(mustextract,k,u)
       IF kk > 3 THEN keys(mustextract,k,u)=blue.blue.hardblue:a$(k,u)=MID$(a$(k,u),1,1):BEEP
       j=j+1
     WEND
  ELSE
     j=0
     z=blue.blue.softblue
     IF allshouldbehardblue THEN z = blue.blue.hardblue
     IF allshouldbered      THEN z=  blue.blue.red
     C=num(typ(kh) AND 15)
     WHILE j < C
       u=use(j+1,typ(kh) AND 15)
       kk=keys(mustextract,k,u)
       IF kk > 3 THEN keys(mustextract,k,u) = z  'skip dead and mod
       j=j+1
     WEND
  END IF
  st=state:IF st>3 THEN st=3
  z=reverse(clrextract(keymap,keys(st,kh,q)))
  IF (clr(kh) <> z) AND (state=keymap) THEN clr(kh)=z:a=kh:GOSUB paintkey
  RETURN
  
actionchange:
oldaction=action
IF (kh=undefined) OR (km=undefined) THEN
   action = 11                         '11 in part
ELSEIF (state=3) AND (clr(kh)=lightblue) AND (km <> undefined) AND (keys(mustextract,km,qm)=red.blue.hardblue) THEN
   action = 12
ELSEIF     (clr(kh)=lightblue) AND (state < 5) THEN
   action = 2*state - 1                '1,3,5,7
ELSEIF (clr(kh)=lightred)  AND (state < 5) THEN   
   action = 2*state                    '2,4,6,8
ELSEIF (clr(kh)=lightgrey) AND (state = 5) THEN
   action = 9                          '9
ELSEIF (clr(kh)=lightgrey)                 THEN
   action = 11                         '11 in part
ELSEIF (state = 5)                         THEN
   IF (clr(kh)<>lightblue) AND (clr(kh)<>lightred) THEN LOCATE 1,1:PRINT "****ABORT***";:STOP
   IF (q=0) OR (q=1) OR (q=2) OR (q=4) OR (q=8)     THEN
      action = 10                      '10
   ELSE
      action = 11                      '11 in part
   END IF
ELSE
   LOCATE 1,1:PRINT "What's left?":STOP
END IF
IF oldaction=action THEN 
   RETURN
ELSE   
  IF action=11 THEN clr(actionkey)=black :ELSE clr(actionkey)=BLUE
  C$(actionkey)=actionmsg$(action)
  a=actionkey:z=clr(actionkey)
  GOSUB paintkey  
END IF
RETURN  
  
erasededkey:
  COLOR black,green:LOCATE 15,27:PRINT "    ";
  COLOR green,green:LINE(ulx(dedkey),uly(dedkey))-(lrx(dedkey),lry(dedkey)),0,bf
  COLOR black,green:LOCATE 15,36:PRINT ml$(16);
  RETURN
drawdedkey:
  IF (clrextract(deadkeys,keys(mustextract,kd,qd))=red) THEN
    COLOR black,0:LOCATE 15,27:PRINT "Dead";
  ELSE
    COLOR black,0:LOCATE 15,27:PRINT "    ";
  END IF
  LINE(ulx(dedkey),uly(dedkey))-(lrx(dedkey),lry(dedkey)),1,b
  COLOR black,0:LOCATE 15,36:PRINT ml$(qd);
  a=dedkey:z=clr(dedkey)
  GOSUB paintkey
  RETURN  




qualoff:
  FOR i=132 TO 135
    clr(i)=black
    a=i:z=black
    GOSUB paintkey
  NEXT i
  clr(130)=black:a=130:z=black:GOSUB paintkey
  clr(131)=black:z=130:z=black:GOSUB paintkey
  RETURN    

 
qualon:
  FOR i= 135 TO 132 STEP -1
    IF (q AND exp2(135-i)) <> 0 THEN 
       clr(i)=red
    ELSE
       clr(i)=BLUE
    END IF
    a=i:z=clr(i)
    GOSUB paintkey
  NEXT i
  clr(130)=BLUE:a=130:z=BLUE:GOSUB paintkey
  clr(131)=BLUE:a=131:z=BLUE:GOSUB paintkey
  RETURN

  
showqual:
REM q is correct but clr(132)-clr(135) may not be
  IF (q AND 8) <> 0 THEN clr(132)=red :ELSE clr(132)=BLUE
  IF (q AND 4) <> 0 THEN clr(133)=red :ELSE clr(133)=BLUE
  IF (q AND 2) <> 0 THEN clr(134)=red :ELSE clr(134)=BLUE
  IF (q AND 1) <> 0 THEN clr(135)=red :ELSE clr(135)=BLUE
  FOR i=132 TO 135: a=i:z=clr(i):GOSUB paintkey:NEXT
  RETURN    


cycleh:
  IF k= 131 THEN
     IF kh=undefined THEN BEEP:RETURN
     IF (typ(kh) = undefined) THEN BEEP:RETURN
       j=1
       gogetit:
       REM use(j,typ(kh)) can NEVER be 99 here  ??wrongo
       IF use(j,typ(kh))>q THEN
          IF use(j,typ(kh)) = 99 THEN q=0 :ELSE q=use(j,typ(kh))
          GOSUB showqual
          GOTO cycleout
       ELSEIF use(j,typ(kh)) = q THEN
          IF j=num(typ(kh)) THEN q=0:GOSUB showqual:GOTO cycleout    
          IF j<num(typ(kh)) THEN q=use(j+1,typ(kh)):GOSUB showqual:GOTO cycleout
       END IF
       j=j+1
       GOTO gogetit
REM  relies very heavily on the fact that for
REM    a defined key there is NO WAY
REM    to make keys(state,kh,0)=black
  END IF
REM  we are here only if k=130
     i=135
     z=BLUE
     WHILE (z=BLUE) AND (i>=132)   'in effect, this is an adder circuit
       z=otherchoice(clr(i))
       a=i
       GOSUB paintkey
       clr(i)=z
       i=i-1
     WEND
     q = q + 1
     IF q=16 THEN q=0
cycleout:
  IF (state = deadkeys) THEN
     qd = q
     COLOR black,0:LOCATE 15,36:PRINT ml$(q);
  ELSE     
     qm = q
     COLOR black,0:LOCATE 18,36:PRINT ml$(q);
  END IF
  GOSUB textchange
  GOSUB repaintkeytops
  GOSUB actionchange
RETURN  
  
qualh:
  b=exp2(135-k)     'b=1,2,4, or 8
  z=otherchoice(clr(k))
  a=k
  GOSUB paintkey
  clr(k)=z
  IF z=BLUE THEN q=q-b
  IF z=red  THEN q=q+b
  IF (state=deadkeys) THEN
     qd = q
     COLOR black,0:LOCATE 15,36:PRINT ml$(q); 
  ELSE
     qm = q
     COLOR black,0:LOCATE 18,36:PRINT ml$(q);
  END IF
  GOSUB textchange
  GOSUB repaintkeytops
  GOSUB actionchange
  RETURN  
  
    
  textchange:
REM  either kh or q has changed
REM 
REM  This is the ONLY routine allowed to write
REM     to loc 18,27
  IF kh=undefined THEN RETURN
REM *******************************************************  
REM Initialize modkey or dedkey as required
IF (state <> deadkeys)  THEN  'so active site is modkey
  km = kh
  qm = q
  C$(modkey) = C$(kh)
  st=state:IF st>3 THEN st=3
  clr(modkey) = reverse(clrextract(state,keys(st,km,qm)))
ELSE                         'active site is dedkey
  kd = kh
  qd = q
  C$(dedkey) = C$(kh)
  clr(dedkey) = reverse(clrextract(deadkeys,keys(mustextract,kh,q)))  
END IF
REM *******************************************************
REM Define kmt and kdt 
REM kmt = 1 if km,qm  is an ordinary key
REM kmt = 2 if km,qm  is a  modifiable key
REM kmt = 3 if km,qm  is a  deadkey
REM kdt = 1 if kd,qd  is an ordinary key  or a modifiable key
REM kdt = 3 if kd,qd  is a  deadkey 
REM kdc = deadkeycode if kd,qd is a deadkey
REM kdc = 0 if kd,qd  is not a deadkey
    kmt=undefined:kdt = undefined
IF (km <> undefined) THEN
   IF clrextract(deadkeys,keys(mustextract,km,qm))=red THEN
       kmt = 3
   ELSEIF clrextract(modifiable,keys(mustextract,km,qm))=red THEN
       kmt = 2
   ELSE 
       kmt = 1
   END IF
END IF
IF (kd <> undefined) THEN
   IF clrextract(deadkeys,keys(mustextract,kd,qd))=red THEN
      kdt = 3
   ELSE
      kdt = 1
   END IF
END IF
IF kdt=3 THEN kdc=deadcode(ASC(a$(kd,qd))) :ELSE kdc=0   
REM *********************************************************   
REM drawdedkey or erasededkey as required
IF (kdt <> undefined) THEN
   IF ((state=deadkeys) OR ((kdt=3)AND(kmt=2))) THEN
         GOSUB drawdedkey
         COLOR black,0:LOCATE 18,27:PRINT "Mod ";
   ELSE
         GOSUB erasededkey
   END IF
END IF
REM *********************************************************
REM draw message for modkey as required
IF  kmt=undefined THEN
    COLOR black,0:LOCATE 18,27:PRINT "    ";
ELSEIF kmt = 1 THEN
    COLOR black,0:LOCATE 18,27:PRINT "Use ";
ELSEIF kmt = 2 THEN
    COLOR black,0:LOCATE 18,27:IF kdt=3 THEN PRINT "Mod "; :ELSE PRINT "Use ";         
ELSE  'kmt = 3 
    COLOR black,0:LOCATE 18,27:PRINT "Dead";
END IF
REM ********************************************************
  a=modkey:z=clr(modkey)
  GOSUB paintkey
  COLOR black,green:LOCATE 18,36:PRINT ml$(qm);
REM ******************************************************  
REM ******************************************************
REM  problem in next line--km might be undefined!!
  IF km<>undefined THEN clr(textkey) = reverse(clrextract(keymap,keys(mustextract,km,qm)))  
IF (kmt=2) THEN
  C$(textkey) = MID$(modi$(ASC(a$(km,qm))),kdc+1,1) '+SPACE$(31)
ELSEIF kmt=3 THEN
  C$(textkey)= "--dead--" ' + SPACE$(24)
ELSEIF kmt=undefined THEN
  C$(textkey)= "--no base key--" '+SPACE$(9)
ELSE  
  C$(textkey) = a$(km,qm)  '+MID$(ml$(16),1,32-LEN(a$(km,qm))) 
END IF
REM pad with blanks
  a=textkey:z=clr(textkey)
  GOSUB paintkey
  COLOR black,z:LOCATE 21,32+LEN(C$(textkey)):PRINT "*";
  RETURN
  
texth:
  x$=r$  
  x=ASC(x$)
  IF helpstatus=inactive AND x=139 THEN 
    helpstatus=active
    RETURN
  END IF  
  IF helpstatus=active THEN
     IF x=83 THEN        'help-Shift-S
      x$=CHR$(19):x=19   '  becomes Ctrl-S (suspends)
     ELSEIF x=72  THEN   'help-Shift-H
      x$=CHR$(8):x=8     '  becomes Ctrl-H (backspaces)
     ELSEIF x=67  THEN   'help-Shift-C
      x$=CHR$(3):x=3     '  becomes Ctrl-C (terminates)
     ELSEIF x=77  THEN   'help-Shift-M
      x$=CHR$(13):x=13   '  becomes Ctrl-M (returns)
     ELSE
       x=(x AND 159) OR 128
       x$=CHR$(x)        '  becomes control character with high bit set
     END IF
  END IF   
there:
  IF (x=13) AND (helpstatus=inactive) THEN  'I. Return pressed
     IF (kmt=undefined) OR (kmt=3) THEN     'I.A.  No key!
        BEEP
     ELSEIF kmt=1 THEN                      'I.B  ordinary key
        a$(km,qm)=text$                     'I.B.i. longtext
        IF (LEN(text$)>1) AND ((keys(mustextract,km,qm)=blue.blue.softblue) OR (keys(mustextract,km,qm)=blue.blue.red)) THEN
           C=num(typ(km))
           m=0
           WHILE m<C
             u=use(m+1,typ(km))
             keys(mustextract,km,u)=blue.blue.red
             m=m+1
           WEND                             'I.B.ii. longtext, illegal
        ELSEIF (LEN(text$)>1) AND (keys(mustextract,km,qm)=blue.blue.hardblue) THEN
           BEEP:a$(km,qm)=MID$(text$,1,1)
        END IF
                                            'I.B.i.  longtext, legal
        IF (state=keymap) AND (LEN(a$(km,qm))>1) AND (clr(kh) <> lightred) THEN
           clr(kh)=lightred:a=kh:z=clr(kh):GOSUB paintkey
           clr(modkey)=lightred:a=modkey:z=clr(modkey):GOSUB paintkey
           clr(textkey)=lightred:a=textkey:z=lightred:GOSUB paintkey
        ELSEIF (LEN(a$(km,qm))=1)  THEN     'I.B.ii. shortext
           k=km:GOSUB stalkcheck
        END IF
        C$(textkey)=a$(km,qm)               'I.C modifiable key
     ELSEIF kmt=2 THEN  'modifiable key, return pressed
        IF LEN(text$)=0 THEN                'I.C.i. notext
           BEEP
        ELSE                                'I.C.ii. longtext
           IF LEN(text$)>1 THEN BEEP:text$=MID$(text$,1,1)
           a=ASC(a$(km,qm))
           MID$(modi$(a),kdc+1,1) = text$
        END IF
        C$(textkey)=text$         
     END IF
     text$=""
     GOSUB textchange              'II.  Backspace
  ELSEIF (x=8) AND (helpstatus=inactive) THEN  'backspace
     IF LEN(text$)=0 THEN
       BEEP
     ELSE
       text$=MID$(text$,1,LEN(text$)-1)
       COLOR black,clr(textkey):LOCATE texty,textx+LEN(text$)
       PRINT " ";
     END IF
                           'III.  Not an Edit Key
  ELSE  'no special meaning for key; not return or backspace
   IF keys(mustextract,km,qm)=blue.blue.hardblue THEN
       text$=x$
       CALL printt(text$,1)
   ELSE  
       text$=MID$(text$,1,31)+x$
       CALL printt(text$,LEN(text$))
   END IF
  END IF
  helpstatus=inactive
  RETURN

subprintt:  
SUB printt(text$,start) STATIC
SHARED texty,textx,BLUE,lightgrey,red,textkey
 back = clr(textkey)
 LOCATE texty,textx+start-1
 fore = lightgrey
 FOR i=start TO LEN(text$)
   y$=MID$(text$,i,1)
   y=ASC(y$)
colors:
   IF y < 32 THEN
      COLOR BLUE,back:PRINT  CHR$(y+64);
   ELSEIF y < 128 THEN
      COLOR fore,back:PRINT y$;
   ELSEIF y < 160 THEN
      COLOR red,back:PRINT CHR$(y-64);
   ELSE
      COLOR fore,back:PRINT y$;
   END IF
 NEXT i
 END SUB
 
breakh:
 s$=CHR$(3)
 RETURN 
 
quith:
 GOSUB clearlineone
 COLOR white,green:LOCATE 1,1:PRINT "Stopped on request";SPACE$(15)
 WINDOW CLOSE 2:SCREEN CLOSE 1
 MENU RESET
 SYSTEM
 STOP 
 
diskerrorh:
  WINDOW OUTPUT 2
  WINDOW 3,,,0,1  'the purpose is to
  WINDOW CLOSE 3 'force our screen front
  errno=ERR
  x=errno
  GOSUB clearlineone
  COLOR 3,0:LOCATE 1,1:PRINT x
  LOCATE 1,1
  IF x=53 THEN
     PRINT "I can't find file ";:COLOR 3,1:PRINT f$;
     COLOR white,green
  ELSEIF x=55 THEN
     PRINT "But the file is already open!";
  ELSEIF x=57 THEN
     PRINT "Fatal device I/O Error";
  ELSEIF x=61 THEN
     PRINT "All disk storage space is in use.  Make more room.";
  ELSEIF x=64 THEN
     PRINT "Filename is illegal.  (Too many characters?)";
  ELSEIF x=67 THEN
     PRINT "Too many files open.";
  ELSEIF x=68 THEN
     PRINT "The device specified is not available at this time.";
  ELSEIF x=70 THEN
     PRINT "The disk is write protected.  Please move the little tab.";
  ELSEIF x=74 THEN
     PRINT "The volume specified has not been mounted.";
  ELSE
     PRINT "Mysterious error.  Didn't work.";
  END IF
  RESUME NEXT

savekeymap:
  MOUSE OFF:MENU OFF:MENU 1,0,0
  bri4=0
  WINDOW 3,"SAVE KEYMAP",(10,20)-(400,75),0,1
emptyinkey:
  IF INKEY$<>"" THEN emptyinkey
  PRINT "Save as what file? "
  IF f$<>"" THEN PRINT "Default is ";f$ :ELSE PRINT
  LINE INPUT ff$
  IF ff$<>"" THEN fff$=ff$ :ELSE fff$=f$
  PRINT "Saving keymap as ";fff$;"?"
  PRINT "Press RETURN to accept, any other key to cancel"
getkey2:
  r$=INKEY$:IF r$ ="" THEN getkey2
  WINDOW CLOSE 3
  MOUSE ON:MENU ON:MENU 1,0,1
  GOSUB clearlineone
  IF r$=CHR$(13) THEN
     f$=fff$
  ELSE
     COLOR white,green:LOCATE 1,1:PRINT "Cancelled":RETURN
  END IF
  COLOR white,green:LOCATE 1,1:   PRINT "            Saving ";f$
  bi=10+36+15+15+120+4*120     'first free space
  LOCATE 1,1:PRINT "zeroes     ":GOSUB writezeroes
  LOCATE 1,1:PRINT "addresses  ":GOSUB writeaddresses
  LOCATE 1,1:PRINT "capsable   ":p=capsable:GOSUB writebittable
  LOCATE 1,1:PRINT "repeatable ":p=repeatable:GOSUB writebittable
  LOCATE 1,1:PRINT "keytypes   ":GOSUB writekeytypes
  LOCATE 1,1:PRINT "keymap     ":GOSUB writekeymap
  GOSUB writefile:
  BEEP
  MOUSE ON
  RETURN

writezeroes:
  FOR j=0 TO 9:buff(j)=0:NEXT j
  RETURN

writeaddresses:
  RESTORE addresslist
  FOR i=0 TO 8:FOR j=0 TO 3:READ buff(10+4*i+j):NEXT j:READ comment$:NEXT i
addresslist:
  DATA  00,00,00, 00,        name (dummy entries)
  DATA  00,00,00, 76,        lokeytypes
  DATA  00,00,00,196,        lokeymap
  DATA  00,00,00, 46,        locapsable
  DATA  00,00,00, 61,        lorepeatable
  DATA  00,00,00,140,        hikeytypes
  DATA  00,00,01,196,        hikeymap
  DATA  00,00,00, 54,        hicapsable
  DATA  00,00,00, 69,        hirepeatable 
  RETURN
  
writebittable:
  IF p=capsable   THEN pbase = 10+36
  IF p=repeatable THEN pbase = 10+36+15
  FOR i=0 TO 14
    d=0
    FOR j=8*i+7 TO 8*i STEP -1
      IF keys(p,j,0)=BLUE THEN b=0 :ELSE b=1  'p=1 or 2 always
      d=2*d+b
    NEXT j
    buff(pbase+i)=d
  NEXT i
RETURN
      
writekeytypes:
  keytype=10+36+15+15
  FOR i=0 TO 119
  IF typ(i)=undefined THEN
    typ(i)=128
  ELSE
   ' GOSUB stalkcheck  should be unnecessary 
    C=num(typ(i))
    litmus=clrextract(keymap,keys(mustextract,i,0))
    IF litmus = BLUE THEN   'all entries 1 character
      REM check if this keycap has a modkey or deadkey
      modhere=false
      j=0
      WHILE NOT modhere AND (j<C)   
        u=use(j+1,typ(i))
        IF keys(mustextract,i,u)=blue.red.hardblue THEN modhere=true
        IF keys(mustextract,i,u)=red.blue.hardblue THEN modhere=true
        j=j+1
      WEND  
      IF modhere THEN
        typ(i)=typ(i) OR 32
      ELSEIF C <=4 THEN
        typ(i)=typ(i)     'nochange
      ELSEIF typ(i)=7 THEN
        REM check for vanilla; note c=8
        vanilla=true
        FOR j=0 TO 3
          IF (ASC(a$(i,j)) AND 159) <> ASC(a$(i,j+4)) THEN vanilla=false
        NEXT j
        IF NOT vanilla THEN typ(i)=typ(i) OR 64
      ELSE 'c > 4  
        typ(i)=typ(i) OR 16  'temporary marker--bit otherwise unused
      END IF
    ELSE   'litmus=red      must be handled as string
      typ(i)=typ(i) OR 64
    END IF
  END IF
  buff(keytype+i)=typ(i) AND 239 'must turn off temporary marker
  NEXT i     
  RETURN
  
writekeymap:
  FOR i=0 TO 119
    IF     (typ(i) AND 16)  <> 0 THEN
       GOSUB writedirect
    ELSEIF (typ(i) AND 32)  <> 0 THEN
       GOSUB writemodstring
    ELSEIF (typ(i) AND 64)  <> 0 THEN
       GOSUB writestring
    ELSEIF (typ(i) AND 128) <> 0 THEN      
       add = 10+36+15+15+120+4*i
       FOR j=0 TO 3
         buff(add+j)=0
       NEXT j
       typ(i)=undefined
   ELSE
      GOSUB writeimmediate
   END IF
  NEXT i
  RETURN 
  
writedirect:
  GOSUB writepointer
  typ(i)=typ(i) AND 15
  C=num(typ(i))
  FOR j=0 TO C-1
    u=use(j+1,typ(i))
    buff(bi+j)=ASC(a$(i,u)) 'should be only 1 character 
  NEXT j
  bi=bi+C
  RETURN 
  
writeimmediate:
  add=10+36+15+15+120+4*i
  FOR j=0 TO 3:temp(j)=0:NEXT j
  C=num(typ(i)):IF typ(i)=7 THEN C=4 'handles vanilla case; note c<5
  FOR j=0 TO C-1
    u=use(j+1,typ(i))
    temp(3-j)=ASC(a$(i,u)+CHR$(0))
  NEXT j
  FOR j=0 TO 3:buff(add+j)=temp(j):NEXT j  
  RETURN    
  
writestring:
  GOSUB writepointer
  typ(i)=typ(i) AND 15
  C=num(typ(i))   'string descriptor has length 2*c
  s=bi + 2*C
  FOR j=0 TO C-1
    u=use(j+1,typ(i))
    buff(bi+2*j)   =LEN(a$(i,u))
    buff(bi+2*j+1) =s-bi    'offset
    FOR m=1 TO LEN(a$(i,u))
      buff(s)=ASC(MID$(a$(i,u),m,1))
      s=s+1
    NEXT m 
  NEXT j
  bi = s
  RETURN
  
writemodstring:
  GOSUB writepointer
  typ(i)=typ(i) AND 15
  C=num(typ(i))  'string descriptor has length 2*c
  s=bi + 2*C
  FOR j=0 TO C-1
    u=use(j+1,typ(i))
    IF keys(mustextract,i,u)=blue.red.hardblue THEN
       buff(bi+2*j)   = 1
       buff(bi+2*j+1) = s - bi
       a=ASC(a$(i,u))
       FOR m=1 TO LEN(modi$(a))
         buff(s)=ASC(MID$(modi$(a),m,1))
         s=s+1
       NEXT m
    ELSEIF keys(mustextract,i,u)=red.blue.hardblue THEN
      buff(bi+2*j)   = 8
      buff(bi+2*j+1) = deadcode(ASC(a$(i,u)))
    ELSE   'ordinary
      buff(bi+2*j)   = 0
      buff(bi+2*j+1) = ASC(a$(i,u)) 'should be only 1 character
    END IF
  NEXT j
  bi = s
 
  RETURN
  
writepointer:
  x$=MKL$(bi)   'convert to 4 byte string
  add=10+36+15+15+120+4*i
  FOR j=0 TO 3:buff(add+j)=ASC(MID$(x$,j+1,1)):NEXT j
  add$=MKL$(add)
  buffreloc$(bri4) = add$
  bri4=bri4+1
  RETURN  
  
writefile:
  add=bi   'save address of name of keymap temporarily
  FOR i=1 TO LEN(f$)
    buff(bi)=ASC(MID$(f$,i,1))
    bi=bi+1
  NEXT i
  buff(bi)=0
  bi=bi+1
  WHILE (bi MOD 4) <> 0
    buff(bi)=0
    bi=bi+1
  WEND
  bi4=bi/4 
  bi4$=MKL$(bi4)
  add$=MKL$(add)
  REM  put address of name where it belongs
  FOR j=0 TO 3:buff(10+j)=ASC(MID$(add$,j+1,1)):NEXT j
  REM *************************************************
  REM now write the actual file out
  fff$="devs:keymaps/"+f$
  ON ERROR GOTO diskerrorh:errno=0
  OPEN fff$ FOR OUTPUT AS #1
  IF errno <> 0 THEN  ON ERROR GOTO 0:RETURN
  PRINT #1,MKL$(1011);    'hunk-header   $000003F3
  PRINT #1,MKL$(0);       '  no names
  PRINT #1,MKL$(1);       '  table size is 1
  PRINT #1,MKL$(0);       '  first hunk is 0
  PRINT #1,MKL$(0);       '  last hunk  is 0
  PRINT #1,bi4$;          '  size of hunk-code
  PRINT #1,MKL$(1001);    'hunk-code     $000003E9
  PRINT #1,bi4$;
  FOR i=0 TO bi-1:PRINT #1,CHR$(buff(i));:NEXT i
  PRINT #1,MKL$(1004);    'hunk-reloc32  $000003EC
  PRINT #1,MKL$(bri4+9);  '  number of references to be relocated
  PRINT #1,MKL$(0);       '  hunk #0
  FOR i= bri4 - 1 TO 0 STEP -1
    PRINT #1,buffreloc$(i);  'the pointers we've inserted
  NEXT i  
  FOR i=8 TO 0 STEP -1
    PRINT #1,MKL$(10+4*i);  'the 9-address table
  NEXT i
  PRINT #1,MKL$(0);        'termination signal
  PRINT #1,MKL$(1010);     'hunk-end     $000003F2
  CLOSE #1
  ON ERROR GOTO 0
  GOSUB clearlineone
  LOCATE 1,1:PRINT "Finished "
  RETURN